C  APPLIES PERSPECTIVE TO DRAWING.  EDGE OF 'PAPER' MAY BE CURVED.
	IMPLICIT INTEGER(X,Y,Z)
	COMMON JHALF,F,LB,D,X,Y,DL,HA,HB,R,RX,FACX
	DIMENSION X1(800),Y1(800),Z1(800),X6(800)
	DIMENSION X2(200),Y2(200),Z2(200),X7(200),Y7(200)
	DIMENSION X3(800),Y3(800),X4(200),Y4(200)
	1  ,JJ(4000),X5(200),Y5(200)
 
	JHALF=0
1	FORMAT(' TYPE PICTURE NAME '$)
2	FORMAT(' TYPE CURVE NAME '$)
3	FORMAT(' TYPE OUTPUT NAME '$)
6	FORMAT(A5)
7	FORMAT(4I)
8	FORMAT(' TYPE X,Y FOR VANISHING POINT. '$)
9	FORMAT(' TYPE FORESHORTENING FACTOR. '$)
13	FORMAT(6F)
14	FORMAT(6I)
400	FORMAT(' LEFT=',I4,' RT=',I4,' TOP=',I4,' BOT='I4)
401	FORMAT(' TYPE X,Y FOR LOWER LEFT CORNER, X FOR RIGHT CORNER,'/
	1' X,Y FOR UPPER LEFT CORNER  '$)
C ASSUMES LEVEL BOTTOM FOR 'PIECE OF PAPER'
4	TYPE 1
	ACCEPT 6,NM1
	TYPE 2
	ACCEPT 6,NM2
	XL=9999
	XR=-XL
	YT=XR
	YB=XL
20	REWIND 1
	REWIND 20
	CALL IFILE(1,NM1)
	CALL IFILE(20,NM2)
	DO 30 KT=1,800
	READ(1,7,END=21)LT,X1(KT),Y1(KT),Z1(KT)
	X=X1(KT)
	Y=Y1(KT)
	IF(X.LT.XL)XL=X
	IF(X.GT.XR)XR=X
	IF(Y.LT.YB)YB=Y
30	IF(Y.GT.YT)YT=Y
C FIND OUTER DIMENSIONS OF PICTURE
21	KT=KT-1
C NOW KT = TOTAL VECTORS 
	J=X2(1)
	JB=J
	TYPE 400,XL,XR,YT,YB
	LB=Y2(1)
	LT=L
	DO 40 K=1,800
	READ(20,7,END=22)LT,X2(K),Y2(K),Z2(K)
	N=X2(K)
	IF(N.LT.J)J=N
	IF(N.GT.JB)JB=N
C ASSUMES BASE LINE IS LEVEL FOR NOW
	N=Y2(K)
	IF(N.LT.LB)LB=N
40	IF(N.GT.LT)LT=N
C GETS TOP AND BOT.  LT,LB
22	K=K-1
CC	IF(LB.GE.0)GO TO 200
CC	DO 201 J=1,K
CC201	Y2(J)=Y2(J)-LB
CC	DO 202 J=1,KT
CC202	Y1(J)=Y1(J)-LB
C SHIFT ALL TO Y POSITIVE IF ANY NEG POINTS
200	CALL DPYSET(1,JJ,4000)
  	CALL DRWIT(X2,Y2,Z2,K)
  	CALL DRWIT(X1,Y1,Z1,KT)
250	FORMAT(' SHIFT PICTURE? '$)
251	FORMAT(' TYPE X SHIFT, Y SHIFT  '$)
	TYPE 250
	ACCEPT 6,XL
	IF(XL.NE.'Y')GO TO 252
	TYPE 251
	ACCEPT 7,XL,LT
	DO 253 J=1,KT
	X1(J)=X1(J)+XL
253	Y1(J)=Y1(J)+LT
	GO TO 200
23	FORMAT(' HORIZONTAL POINTS ARE ',2I4)
24	FORMAT('  VERTICAL  POINTS ARE ',2I4)
C	TYPE 23,J,JB
C	TYPE 24,LB,LT
C ASSUMES TOP AND BOT OF CURVE ARE AT X=0, BOT AT Y=0.
252	TYPE 401
	ACCEPT 14,XL,YB,XR,XL2,YT
	FA=LT-LB
C HEIGHT OF CURVE  (LB SHOULD BE 0)
	FB=YT-YB
C HEIGHT OF 'PIECE OF PAPER' (YB SHOULD BE 0)
	G=FB/FA
C FACTOR FOR SIZE DIFFERENCE BETWEEN PAPER AND CURVE
C	LT=LT*G
	LT=JMUL(LT,G)
	LB=LB*G
C	XL=XH*G+.5
	XL=JMUL(XH,G)
C	XR=XR*G+.5
CC	XR=JMUL(XR,G)
C	YT=YT*G+.5
	YT=JMUL(YT,G)
C	YB=YB*G+.5
	YB=JMUL(YB,G)
* SCALE EVERYTHING DOWN
	FC=XL2-XL
C OFFSET TO TOP OF SLANTED 'PIECE OF PAPER'
25	DO 15 J=1,K
	PC=(Y2(J)-LB)/FA
C % OF WAY UP FROM BOT.
C	Y7(J)=G*Y2(J)+.5
	Y7(J)=JMUL(Y2(J),G)
C EXPAND Y TO FIT PAPER
	Y4(J)=Y7(J)
C	X7(J)=X2(J)*G+FC*PC+.5
CCC	X7(J)=X2(J)+FC
	X7(J)=JMUL(X2(J),G)+FC*PC
C EXPAND X BY SAME FACTOR AND TILT IF NECESSARY
15	X4(J)=X7(J)+XR
C SET UP RIGHT SIDE OF PIECE OF PAPER
	CALL DRWIT(X7,Y7,Z2,K)
	CALL DRWIT(X4,Y4,Z2,K)
C  NOW BEND DRAWING TO FIT GIVEN CURVE
	J=1
500	S=X1(J)
	T=Y1(J)
	DO 501 L=1,K-1
C ASSUMES CURVE GOES BELOW AND ABOVE PICTURE
	R=Y7(L)
	RR=Y7(L+1)
	IF(T.LT.R.OR.T.GT.RR)GO TO 501
C	H=X7(L)-X7(L+1)
	HA=X7(L)
	H=X7(L+1)-HA
C	G=(R-T)/(Y2(L+1)-T)
	G=(R-T)/(R-Y7(L+1))
C G=% OF WAY BETWEEN POINTS
C	X6(J)=HA+S+H*G+.5
	HH=HA+S+H*G
	IF(HH.GT.0)HH=HH+.5
	IF(HH.LT.0)HH=HH-.5
	X6(J)=HH
	J=J+1
	IF(J.LE.KT)GO TO 500
	GO TO 502
501	CONTINUE
502	CALL DRWIT(X6,Y1,Z1,KT)
	TYPE 8
	ACCEPT 7,X,Y
	CALL AIVECT(X7(K)-100,Y7(K))
	CALL AVECT(X-100,Y)
	CALL AVECT(X7(1)-100,Y7(1))
	CALL DPYOUT(1)
C SHOWS VANISHING POINT
	TYPE 9
	ACCEPT 13,F
	IF(F.EQ.0)F=1
	HA=Y7(K)-Y
C HEIGHT FROM VP TO TOP OF RECT.
	HB=Y7(1)-Y
C HEIGHT FROM VP TO BOT OF RECT.
	DL=X-X7(1)
C LENGTH FROM LEFT EDGE OF RECT. TO VP
	M1=1
C GET FIRST POINTS
C G,LT=TOP OF RECT.  H,LB=BOT OF RECT.
	G=LT
	H=LB
	D=G-H
C D=HEIGHT OF RECT.
	F=F*XR/DL
C FORESHORTENING FACTOR IS CHANGED BE RELATION OF SEGMENT ACROSS
C VANISHING POINT LINES AT RIGHT EDGE OF PIECE OF PAPER.
32	DO 31 J=1,K
31	CALL FORSH(X7(J),Y7(J),X7(J),Y7(J))
27	DO 26 J=1,K
26	CALL FORSH(X4(J),Y4(J),X5(J),Y5(J))
	CALL DRWIT(X5,Y5,Z2,K)
28	DO 10 M1=1,KT
10	CALL FORSH(X6(M1),Y1(M1),X3(M1),Y3(M1))
12 	CALL DRWIT(X3,Y3,Z1,KT)
300	FORMAT(' WRITE FILE? '$)
	TYPE 300
	ACCEPT 6,J
	IF(J.NE.'Y')GO TO 301
	TYPE 3
	ACCEPT 6,J
	CALL OFILE(21,J)
	IF(JHALF.NE.0)GO TO 304
	DO 302 J=1,KT
302	WRITE(21,7)J,X3(J),Y3(J),Z1(J)
C WRITES FILE TO BE USED WITH 'RE' IN THE DRW PROGRAM.
	J=KT
	DO 306 JK=1,K
	J=J+1
306	WRITE(21,7)J,X5(JK),Y5(JK),Z2(JK)
	DO 307 JK=1,K
	J=J+1
307	WRITE(21,7)J,X7(JK),Y7(JK),Z2(JK)
	J=J+1
	JK=1
	WRITE(21,7)J,X5(1),Y5(1),JK
	J=J+1
	JL=0
	WRITE(21,7)J,X7(1),Y7(1),JL
	J=J+1
	WRITE(21,7)J,X5(K),Y5(K),JK
	J=J+1
	WRITE(21,7)J,X7(K),Y7(K),JL
303	JHALF=0
	END FILE 21
301	CALL HYDPOG(1)
	GO TO 200
304	DO 305 J=1,KT
C HALF SIZE IF X OR Y .GE.1000
	LX=X3(J)/2
	LY=Y3(J)/2
305	WRITE(21,7)J,LX,LY,Z1(J)
	GO TO 303
	END 

	SUBROUTINE DRWIT(X,Y,Z,K)
	INTEGER X,Y,Z
	DIMENSION X(1),Y(1),Z(1)
	DO 1 J=1,K
	IF(Z(J).EQ.0)GO TO 2
	CALL AIVECT(X(J)-100,Y(J))
	GO TO 1
2 	CALL AVECT(X(J)-100,Y(J))
1 	CONTINUE
	CALL DPYOUT(1)
	END

	SUBROUTINE FORSH(XA,YA,XB,YB)
	IMPLICIT INTEGER (X,Y)
	COMMON JHALF,F,LB,D,X,Y,DL,HA,HB,R,RX,FACX
C  D=HEIGHT OF 'PIECE OF PAPER', DL=DIST. FROM LEFT EDGE TO VP.
C SET NEW X VALUE FOR THIS POINT
	A=DL-XA
	XB=(DL-A*A/DL)*F
C  FORESHORTENING FORMULA
2	A=1.0-XB/DL
C NOW GET VERTICAL SEG. FOR ALTERED X VALUE
	B=A*HA+Y
	C=A*HB+Y
3	FAC=(B-C)/D
C FACTOR FOR Y VALUE
C	YB=YA*FAC+C+.5
	CC=YA*FAC+C
	IF(CC.LT.0)CC=CC-.5
	IF(CC.GT.0)CC=CC+.5
	YB=CC
4	IF(IABS(YB).GE.1000)JHALF=-1
	IF(IABS(XB).GE.1000)JHALF=-1
	END

	FUNCTION JMUL(N,R)
	A=N*R
	IF(A.LT.0)A=A-.5
	IF(A.GT.0)A=A+.5
	JMUL=A
	END